home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
COMMUNIC
/
H191.ZIP
/
CA29-3.EXE
/
REMAP.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1992-03-23
|
28KB
|
1,165 lines
S29 = "INTERNAL" ; Set your editor here
; ; .. "INTERNAL" -> Our own editor
; ----- COM-AND Compile remap table
;
; This script opens a window asking 1) to compile new remap, 2) turn
; remapping on, and 3) turn remap off.
;
; The big job, of course, if the compilation of remapping values.
; The result of the compilation is saved unconditionally as COM-AND.RMP.
;
; R.McG, commenced 2/89
; updated 3/92 (to use internal editor)
; ----- Usages -----------------
; S29 -----> The fully qualified EDITOR program file name
; S19 -----> COM-AND.RMP file name to be used
; S18 -----> Source file being compiled
; N99 -----> The # of errors in compilation
; N98 -----> The output file size
; N97 -----> # name commands to allow (set in SELECT)
; FLAG(9) -> Escape during compile (wait for another ESC)
; FLAG(8) -> If true, syntax check only
; ------------------------------
; Initialization
;
;* TRACE ON
ON ESCAPE GOSUB Exit ; SAVE is performed in Window
LEGEND " Remap compiler (ver 1.2)"
SET TTHRU OFF ; Disallow typeahead
GOSUB Set_Fname ; Get current fname
UPPER S19 ; Make nice for display
;
; Open a window
;
GOSUB Window ; Open main window
;
; Wait for a keystroke
;
Keyin:
LOCATE 18,20
ATSAY 18,20 (default) " "
KEYGET S0
IF NULL S0(1:3)
ATSAY 18,20 (default) S0
ENDIF
;
; Interpret the response
;
SWITCH S0
CASE "1" ; Compile
GOSUB Compile
ENDCASE
CASE "2" ; Syntax
GOSUB Syntax
ENDCASE
CASE "3" ; Search for file
GOSUB Alt_F
ENDCASE
CASE "4" ; Edit a file
GOSUB Edit
ENDCASE
CASE "5" ; Remap on
GOSUB Mapon
ENDCASE
CASE "6" ; Remap off
GOSUB Mapoff
ENDCASE
DEFAULT ; None of the above
SOUND 100,100
GOTO Keyin ; Try again
ENDCASE
ENDSWITCH
GOTO KEYIN
;
; ----- Subroutine Exit - terminate the process
;
Exit:
DO ; CLose any open windows
WCLOSE
UNTIL FAILURE
EXIT
;
; ----- Subroutine Mapon - turn on mapping (using current file)
;
MapOn:
SET REMAP ON ; Enable
RETURN
;
; ----- Subroutine MapOff - turn off mapping
;
MapOff:
SET REMAP OFF ; Disable
RETURN
;
; ----- Perform an Alt-F - file search
;
Alt_F:
WOPEN 10,1 13,78 (default) ErrEsc
ATSAY 10,3 (default) " Search for files "
ATSAY 11,3 (default) "Enter a search template (e.g. 'd:\subd\x*.AR?')."
ATSAY 12,3 (default) "-> "
ATSAY 13,30 (default) " Press ESC to cancel "
ATGET 12,6 (default) 50 S0
WCLOSE
;
; If not null, perform the request
;
IF NOT NULL S0
DIR S0 ; Make upper case
ENDIF
RETURN
;
; ----- Invoke an editor to edit a file
;
Edit:
IF NOT NULL S29 GOTO Edit100
;
; Open a window and ask for the editor's name
;
WOPEN 10,1 13,78 (default) ErrEsc
ATSAY 10,3 (default) " Edit file "
ATSAY 11,3 (default) "Enter the editor's name, fully qualified (e.g. C:\PE.EXE)."
ATSAY 12,3 (default) "-> "
ATSAY 13,30 (default) " Press ESC to cancel "
ATGET 12,6 (default) 50 S0 ; ErrEsc clears S0, so we use it
WCLOSE
IF NULL S0 RETURN ; Return on empty answer
S29 = S0 ; Save for next time
;
; Open another window and ask for the file name
;
Edit100:
WOPEN 10,1 13,78 (default) ErrEsc
ATSAY 10,3 (default) " Edit file "
ATSAY 11,3 (default) "Enter the file name to be edited:"
ATSAY 12,3 (default) "-> "
ATSAY 13,30 (default) " Press ESC to cancel "
ATGET 12,6 (default) 50 S0 ; ErrEsc clears S0, so we use it
WCLOSE
;
; If not null, perform the request
;
IF NOT NULL S0 and (NOT NULL S29 and NOT FIND S29 "INTERNAL")
RUN S29 * " " *S0 ; Make upper case
IF FAILED S29 = "INTERNAL" ; Clear S29 if failed
ENDIF
IF (NULL S29 or FIND S29 "INTERNAL") and NOT NULL S0 EDIT S0
RETURN
;
; ----- Construct the file name we'll use for COM-AND.RMP
;
Set_Fname:
S19 = "COM-AND.RMP" ; Default to current subdir
IF ISFILE S19 ; Look for file on default subdir
RETURN ; Exit here
ENDIF
;
; ----- Construct the file with the COM-AND= pathing (if provided)
;
ENVIRON S1 "COM-AND=" ; Look for COM-AND= environment var
IF FOUND ; If environment variable found
LENGTH S1 N0 ; Get its length
N0 = N0-1 ; Point to last char in string
IF not STRCMP S1(n0:n0) "\"
N0 = N0+1
CONCAT S1(n0) "\"
ENDIF
ENDIF
S19 = S1&"COM-AND.RMP" ; Concatenate path and name
RETURN
;
; ----- Subroutine: error
; .. Open a window, display, and and await keypress
; S0,S1 pass the message(s) to display
;
Error:
WOPEN 10,1, 13,77 (contrast) ErrEsc
ATSAY 11, 3 (contrast) S0(0:73)
ATSAY 12, 3 (contrast) S1(0:73)
ATSAY 13,26 (contrast) " Press any key to continue "
SOUND 880,100
KEYGET S0 ; Wait for any key
WCLOSE ; Restore screen under
RETURN ; And return to caller
;
; Escape during "Error" window
;
ErrEsc:
S0 = "" ; Make S0 null
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Test S0 for a valid (known) keycode
; Parameter S0 ------> The keycode being passed
; Return: FLAG(0) <- TRUE if erroneous keycode
; S0 <------ The converted keycode (if FLAG(0) false)
; N0 <------ The length of the converted keycode
;
Keycode:
LJ S0 ; Force left justification
S0 = S0&"" ; Trim trailing blanks
SET FLAG(0) OFF ; Default return value
LENGTH S0 N0 ; Compute len of parm
;
; Catch decimal and hex numbers here
;
IF NUMERIC S0(0:0) ; Case insensitive test here
ATOI S0 N0 ; Convert value
IF (NOT ERROR) and (GE N0 0 and LE N0 255)
ITOC N0 S0 ; Return value 0-255 as char
N0 = 1 ; Set rtn length
RETURN
ENDIF
ENDIF
;
; Switch according to length here
;
SWITCH N0
CASE 1 ; 1 char wide
GOTO TEKE100
ENDCASE
CASE 2 ; 2 chars wide
GOTO TEKE200
ENDCASE
CASE 3 ; 3 chars wide
GOTO TEKE300
ENDCASE
CASE 4 ; 4 chars wide
GOTO TEKE400
ENDCASE
CASE 5 ; 5 chars wide
GOTO TEKE500
ENDCASE
CASE 6 ; 6 chars wide
GOTO TEKE600
ENDCASE
DEFAULT
SET FLAG(0) ON ; Others are errors
RETURN
ENDCASE
ENDSWITCH
;
; ***** Single character keycode here (take char as-is)
;
TEKE100:
N0 = 1 ; Return length here (char already in S0)
RETURN
;
; ***** Two character keycode here: First: ^chars
;
TEKE200:
IF STRCMP S0(0:0) "^" ; Caret initially
UPPER S0 ; Make upper case
CTOI S0(1:1) N0
ITOC (N0-64) S0 ; Convert to control form, and place
N0 = 1
RETURN
ENDIF
;
; Catch F0-F9
;
IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0 N0
IF NE 0 (N0\3) ; Modulo divide (remainder)
SET FLAG(0) ON ; .. catch e.g. "0,"
RETURN
ENDIF
ITOC 0 S0
ITOC (0x3b+N0/3) S0(1)
N0 = 2
RETURN
ENDIF
;
; Catch cr and bs here
;
SWITCH S0
CASE "CR" ; Carriage Rtn
ITOC 13 S0
N0 = 1
RETURN
ENDCASE
CASE "BS" ; Carriage Rtn
ITOC 8 S0
N0 = 1
RETURN
ENDCASE
ENDSWITCH
;
; Other pairs are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Three character keycode here: First, rtn a quoted character
;
TEKE300:
IF STRCMP S0(0:0) "`"" and STRCMP S0(2:2) "`""
S0 = S0(1:1)
N0 = 1 ; Return length here (char in S0)
RETURN
ENDIF
;
; Catch SF0-SF9, CF0-CF9, AF0-AF9, ^F0-^F9
;
UPPER S0
IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(1:2) N0
IF NE (N0\3) 0 ; Modulo divide (remainder)
SET FLAG(0) ON ; .. catch e.g. "0,"
RETURN
ENDIF
;
; Look at the leading character
;
FIND "SCA^" S0(0:0) N1
SWITCH N1
CASE 0 ; AF0,AF1...
ITOC (0x54+N0/3) S0(1)
ENDCASE
CASE 1 ; CF0,CF1...
ITOC (0x5E+N0/3) S0(1)
ENDCASE
CASE 2 ; AF0,AF1...
ITOC (0x68+N0/3) S0(1)
ENDCASE
CASE 3 ; ^F0,^F1...
ITOC (0x5E+N0/3) S0(1)
ENDCASE
DEFAULT
SET FLAG(0) ON
RETURN
ENDCASE
ENDSWITCH
;
; Return with the goods
;
ITOC 0 S0 ; Modify S) after look for "SCA^"
N0 = 2
RETURN
ENDIF
;
; And finally, 'END','ESC', 'TAB' and 'F10'
;
SWITCH S0
CASE "END" ; Endkey
ITOC 0x4f S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "TAB" ; Tabkey
ITOC 9 S0
N0 = 1
RETURN
ENDCASE
CASE "ESC" ; Esckey
ITOC 0x1b S0
N0 = 1
RETURN
ENDCASE
CASE "F10" ; F10 key
ITOC 0x44 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "INS" ; Inskey
ITOC 0x52 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "DEL" ; Delkey
ITOC 0x53 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Four character keycode here
;
TEKE400:
;
; Catch AltA-AltZ, Alt0-Alt9, Alt-
;
UPPER S0
IF FIND "ALT" S0(0:2) ; Case insensitive test
;
; Catch Alt'd QWERTYUIOP
;
IF FIND "QWERTYUIOP" S0(3) N0
ITOC (0x10+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Catch Alt'd ASDFGHJKL
;
IF FIND "ASDFGHJKL" S0(3) N0
ITOC (0x1E+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Catch Alt'd ZXCVBNM
;
IF FIND "ZXCVBNM" S0(3) N0
ITOC (0x2C+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Catch Alt'd 1234567890-
;
IF FIND "1234567890-" S0(3) N0
ITOC (0x78+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Other Alt's are errors
;
SET FLAG(0) ON
RETURN
ENDIF
;
; Now, 'SF10', 'CF10' 'AF10' and '^F10'
;
IF FIND "F10" S0(1:3) ; Last 3 chars are F10
FIND "SCA^" S0(0:0) N0
SWITCH N0
CASE 0 ; AF0,AF1...
ITOC 0x5D S0(1)
ENDCASE
CASE 1 ; CF0,CF1...
ITOC 0x67 S0(1)
ENDCASE
CASE 2 ; AF0,AF1...
ITOC 0x71 S0(1)
ENDCASE
CASE 3 ; ^F0,^F1...
ITOC 0x67 S0(1)
ENDCASE
DEFAULT
SET FLAG(0) ON
RETURN
ENDCASE
ENDSWITCH
;
; Return with the goods
;
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Finally, Catch 'home', 'Pgup', 'PgDn', CURL', 'CURR', 'BELL' ,'^END'
;
SWITCH S0
CASE "^END" ; Ctl-Endkey
ITOC 0x75 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "HOME" ; Homekey
ITOC 0x47 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "PGUP" ; PgDnkey
ITOC 0x49 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "PGDN" ; PgUpkey
ITOC 0x51 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURL" ; Cursor left
ITOC 0x4B S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURR" ; Cursor right
ITOC 0x4D S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "BELL" ; Bell char
ITOC 7 S0
N0 = 1
RETURN
ENDCASE
CASE "NULL" ; Alt-NumKeyPad-0
ITOC 3 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Five character keycode here; First, catch AltF1-AltF9
;
TEKE500:
UPPER S0
IF FIND "ALT" S0(0:2) ; Case insensitive test
IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(3:4) N0
IF NE (N0\3) 0 ; Modulo divide (remainder)
SET FLAG(0) ON ; .. catch e.g. "0,"
RETURN
ENDIF
ITOC 0 S0
ITOC (0x68+N0/3) S0(1)
N0 = 2
RETURN
ENDIF
;
; Catch AltEq here (syntax doesn't allow Alt=)
;
IF FIND "EQ" S0(3:4)
ITOC 0 S0
ITOC (0x83+N0/3) S0(1)
N0 = 2
RETURN
ENDIF
;
; Other Alt's are errors
;
SET FLAG(0) ON
RETURN
ENDIF
;
; Catch "^Home", "^PgUp", "^PgDn" "^CurR", "^CurL", "CurUp" and "CurDn"
;
SWITCH S0
CASE "^HOME" ; Ctl-Homekey
ITOC 0x77 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^PGUP" ; Ctl-PgDnkey
ITOC 0x84 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^PGDN" ; Ctl-PgUpkey
ITOC 0x76 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^CURL" ; Cursor left
ITOC 0x73 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^CURR" ; Cursor right
ITOC 0x74 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURDN" ; Cursor down
ITOC 0x50 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURUP" ; Cursor up
ITOC 0x48 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Six character keycode here
; .. Catch 'AltF10', '^PrtSc'
;
TEKE600:
SWITCH S0
CASE "AltF10" ; Alt'd F10
ITOC 0x71 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^PRTSC" ; Ctl-PrtSc
ITOC 0x72 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "RevTab" ; Reverse tab
ITOC 0x0f S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; Escape during "compile" window
; .. wait for a second esc
;
CompEsc:
IF FLAG(9)
SET FLAG(9) OFF
RETURN
ENDIF
MESS "^M^JEsc pressed^M^JPress any key again to continue^M^J"
SET FLAG(9) ON
Hang:
IF FLAG(9)
GOTO Hang
ENDIF
RETURN
;
; ----- Subroutine: Scan the input file for sections
; If sections found, ask for a selection
; Return: FLAG(0) <- TRUE if use ESC'd
; FLAG(0) <- FALSE -> File positioned for start
; N97 -> THe number of "NAME" commands to pass by
;
Select:
N97 = 1 ; Default one
N10 = 0 ; # of sections found
SET FLAG(1) OFF ; F -> Nothing compilable preceding 1st section
WOPEN 10,1 12,78 (default) ErrEsc
ATSAY 10,3 (default) " Select section "
ATSAY 11,3 (default) "Scanning for sections in the source file..."
ATSAY 12,30 (default) " ESC ends script "
;
; Save the current position, and read a line
;
SELE100:
FSAVEI ; Save current position
READ S0 80 N0 ; Len read into N0
IF EOF
FSAVEI POP ; Throw away the EOF position
GOTO End_Select
ENDIF
;
; Catch comments here (note save-stack pops)
;
IF NULL S0
FSAVEI POP ; Throw away saved position
GOTO SELE100
ENDIF
LJ S0 ; Left justify
IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
FSAVEI POP ; Throw away saved position
GOTO SELE100
ENDIF
;
; Extract the 1st field into S1
;
FIND S0 "=" N1 ; Find an '=' sign
S1 = S0(0:N1-1) ; Extract keycode
LJ S1
IF EQ N1 0 or NULL S1 ; = in col 0, or empty keycode
FSAVEI POP ; Throw away saved position
GOTO SELE100
ENDIF
;
; The section heading, (NAME = ...) terminates I/O
;
IF NOT FIND S1(0:3) "NAME" ; Case insensitive test
FSAVEI POP ; Throw away saved position
IF ZERO N10 ; Not in a section
SET FLAG(1) ON ; Mark a compilable line in unnamed section
ENDIF
GOTO SELE100 ; Skip if not section cmd
ENDIF
;
; Extract the operand field
;
S2 = S0(N1+1:79) ; Extract section name
LJ S2
;
; We have found a section command - if the first - open a window
;
IF NOT ZERO N10 ; Test if already found a section
GOTO SELE200 ; SKip if window is open
ENDIF
WCLOSE ; Close open window (scanning...)
WOPEN 0 ,10 19,70 (default)
ATSAY 0 ,12 (default) " Remap Select "
ATSAY 1 ,11 (default) " The source file contains multiple sections. These are: "
ATSAY 2 ,12 (default) " 1)"
ATSAY 3 ,12 (default) " 2)"
ATSAY 4 ,12 (default) " 3)"
ATSAY 5 ,12 (default) " 4)"
ATSAY 6 ,12 (default) " 5)"
ATSAY 7 ,12 (default) " 6)"
ATSAY 8 ,12 (default) " 7)"
ATSAY 9 ,12 (default) " 8)"
ATSAY 10,12 (default) " 9)"
ATSAY 11,12 (default) " 10)"
ATSAY 12,12 (default) " 11)"
ATSAY 13,12 (default) " 12)"
ATSAY 14,12 (default) " 13)"
ATSAY 15,12 (default) " 14)"
ATSAY 16,12 (default) " 15)"
ATSAY 17,10 (default) "├───────────────────────────────────────────────────────────┤"
ATSAY 18,12 (default) "Select (1-10):"
ATSAY 19 32 (default) " Press ESC to exit "
;
; If there's an initial unnamed section, name it
;
IF NOT FLAG(1) ; If not compilable source before section...
GOTO SELE200 ; .. skip this
ENDIF
ATSAY N10+2,16 (default) "Unnamed 1st section"
INC N10
;
; Add the section name to the list
;
SELE200:
IF NULL S2
S2 = "Unnamed section #"&N10
ENDIF
ATSAY N10+2,16 (default) S2(0:48)
INC N10
IF LT N10 15 ; Allow up to 15 sections
GOTO SELE100
ENDIF
;
; End of file scan - ask for a selection if there're sections
;
End_Select:
IF ZERO N10 or EQ N10 1 ; No sections found or only one
REWIND ; Rewind input file
SET FLAG(0) OFF ; Return O-K
WCLOSE ; Close 'scanning...' window
RETURN
ENDIF
;
; Prompt for a selection
;
ENSE100:
MESS "^G"
ATGET 18,27 (default) 2 S0
IF NULL S0
SET FLAG(0) ON
ENDIF
;
; Interpret the response
;
ATOI S0 N0
IF LT N0 1 or GT N0 N10
SOUND 100,100
GOTO ENSE100
ENDIF
;
; Use the selected # to pop the save stack
;
WCLOSE ; Close 'select window'
WHILE LE N0 N10
FRESTOREI ; Move back through saved positions
DEC N10 ; .. and decremnet index
ENDWHILE
IF EQ N0 1 and FLAG(1) ; There was an unnamed section and we want it
REWIND ; .. move to beginning of file
N97 = 0 ; Pass by no NAME commands
ENDIF
;
; And return positioned OK
;
SET FLAG(0) OFF
FSAVEI CLEAR
RETURN
;
; ----- Subroutine Syntax check a source file
;
Syntax:
SET FLAG(8) ON
GOTO Start
;
; ----- Subroutine Compile: compile a source file into COM-AND.RMP
;
Compile:
SET FLAG(8) OFF ; Turnoff syntax check
SET FLAG(9) OFF ; ESC during compile
;
; ----- Start compilation
;
Start:
WOPEN 10,1, 13,77 (contrast) ErrEsc
ATSAY 11, 3 (contrast) "Enter the source file name (with or without path/drive)."
ATSAY 12, 3 (contrast) "-> "
ATSAY 13,29 (contrast) " Press ESC to cancel "
;
; Ask for a file name
;
ATGET 12, 7 (contrast) 60 S0 ; Get source file name
WCLOSE ; Restore screen under
IF NULL S0
RETURN ; End here
ENDIF
;
; Attempt to open the given file
;
IF NOT ISFILE S0
S1 = S0
S0 = "File does not exist (or cannot be opened)"
GOSUB Error
GOTO Compile ; Try again
ENDIF
FOPENI S0 TEXT ; Try to open as text
IF FAILURE
S1 = S0
S0 = "Source file cannot be opened"
GOSUB Error
GOTO Compile ; Try again
ENDIF
S18 = S0 ; Save open file name
;
; Scan the file for 'section' names... if found, ask for a selection
; On return, if FLAG(0) reset (off), file is positioned for I/O
; Else, user ESC'd
;
GOSUB Select
IF FLAG(0)
RETURN
ENDIF
;
; Open (and purge) the output file
;
IF NOT FLAG(8) ; If not syntax check
FOPENO S19 BINARY
IF FAILURE
S1 = S0
S0 = "Target file cannot be opened"
GOSUB Error
RETURN ; Error fatal to this subroutine
ENDIF
ENDIF
;
; Set a display window for compilation
;
WOPEN 5,15 20,65 (contrast) CompESC
ATSAY 5,17 (contrast) " Remap compilation "
ATSAY 20,30 (contrast) " Press ESC to pause "
DWINDOW 6,17 19,63 ; Actual scrolling region
CLEAR ; Clear the whole region
;
; Other initialization
;
N99 = 0 ; # errors
N98 = 0 ; Output file size
SET FLAG(9) OFF ; Escape during compile
;
; ***** Read a line and display it
; N99 -----> Counts the # errors
;
Loop:
READ S0 80 N0 ; Len read into N0
IF EOF
GOTO End_Compile
ENDIF
S1 = S0 ; Replicate
PRESERVE S1 ; Keep bangs and carets
MESS S1 ; Display the line (just as read)
;
; Catch comments here
;
IF NULL S0
GOTO LOOP
ENDIF
LJ S0 ; Left justify
IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
GOTO LOOP
ENDIF
;
; Extract the keycode into S1
;
FIND S0 "=" N1 ; Find an '=' sign
S1 = S0(0:N1-1) ; Extract keycode
LJ S1
IF EQ N1 0 or NULL S1 ; = in col 0, or empty keycode
MESS "*** Missing keycode ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; The 2nd time we hit a section heading, (NAME = ...) make an EOF
;
IF FIND S1(0:3) "NAME" ; Case insensitive test
IF ZERO N97 ; # NAME = lines found so far
GOTO End_Compile ; pseudo EOF
ENDIF
DEC N97 ; Pass this one by, byt count it
GOTO Loop ; Throw away 1st
ENDIF
;
; Extract the operand into S2
;
S2 = S0(N1+1:79) ; Extract operand
LJ S2
IF NULL S2 ; Empty assignment
MESS "*** Missing assignment ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; Look at the keycode in S1
;
S0 = S1 ; Parameter passed
GOSUB Keycode
IF FLAG(0)
MESS "*** Invalid keycode ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
S3 = S0 ; Keep converted value
N3 = N0 ; Keep length of conversion so far
;
; Initialize the output operand
;
S4 = "" ; Nake it null
N4 = 0 ; Length so far
;
; ***** Now - begin handling the operand
;
LOOP100:
LJ S2 ; Throw away leading blanks
IF NULL S2
GOTO LOOP300 ; When its null, end of operand
ENDIF
IF STRCMP "," S2(0:0) ; Look for a leading comma
S2 = S2(1:79) ; Throw away comma
GOTO LOOP100 ; And continue
ENDIF
;
; Catch quotes here
;
IF STRCMP "`"" S2(0:0) ; Look for a leading double quote
GOTO LOOP200 ; Handle it specially in operand
ENDIF
;
; ";" terminator allows comments in-line
;
IF STRCMP ";" S2(0:0) ; Look for a leading semi-colon
GOTO LOOP300 ; Treat as-if end of line
ENDIF
;
; Parse out something
;
FIND S2 " " N5 ; Find position of next blank
FIND S2 "," N6 ; Find position of next comma
IF EQ N6 N5 ; Both -1 if neither found
S0 = S2 ; Neither a ' ' or ',' - use whole string
S2 = "" ; Null remaining operand
ELSE
IF EQ N6 -1 ; use N5
ELSE
IF EQ N5 -1 or LT N6 N5
N5 = N6 ; Set N5 to smaller legit value
ENDIF
ENDIF
S0 = S2(0:N5-1) ; Extract what we found
S2 = S2(N5+1:79) ; And remove it from the string
ENDIF
;
; One keycode is an operand only... handle it
;
IF FIND S0(0:5) "Functn"; Special function
ITOC 0 S4(N4)
ITOC 0x80 S4(N4+1) ; Made-up extended code for COM-AND
N4 = N4+2
GOTO LOOP100
ENDIF
;
; Test for a token
;
GOSUB Keycode
IF FLAG(0)
MESS "*** Invalid code in operand ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; Test for a circular definition
;
IF N0 eq 2 AND STRCMP S3(1) S0(1)
MESS "*** Remap would be circular ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; Add the non-ascii key to the operand
;
CONCAT S4(N4) S0(0:N0-1); Concatenate converted string into S4
N4 = N4+N0 ; Keep length of conversion so far
GOTO LOOP100
;
; ***** Handle a quoted string in the operand here
;
LOOP200:
S2 = S2(1:79) ; Eliminate leading char
IF NULL S2 ; Missing terminating ""
MESS "*** Invalid quoted string ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
IF STRCMP S2(0:0) "`"" ; If we find a second ""
S2 = S2(1:79) ; .. Eliminate it
GOTO LOOP100 ; .. and continue
ENDIF
IF STRCMP S2(0:0) "^^"
S2 = S2(1:79) ; Eliminate leading caret
IF STRCMP S2(0:0) "^^"
CONCAT S4(N4) "^^"; ^^ -> ^ in output
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ELSE
S5 = S2(0:0) ; Take just 1st char
UPPER S5 ; Upper case it alone
CTOI S5 N5
ITOC (N5-64) S4(N4)
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ENDIF
ENDIF
IF STRCMP S2(0:0) "!!" ; DOn't want STRCMP to collapse it
IF STRCMP S2(1:1) "!!"
S2 = S2(1:79) ; Eliminate leading bang
CONCAT S4(N4) "!!"; !! -> ! in output
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ELSE
ITOC 13 S4(N4) ; Else "!" -> C/r
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ENDIF
ENDIF
IF STRCMP S2(0:0) "``"
S2 = S2(1:79) ; Eliminate leading grave
IF NULL S2 ; Ignore final grave...
GOTO LOOP200
ENDIF
ENDIF
CTOI S2 N5 ; Take char as-is
ITOC N5 S4(N4)
N4 = N4+1
GOTO LOOP200
;
; ***** Look for an empty operand
; N3 -> The length of the keycode (1,2) in S3
; N4 -> The length of the operand in S4
;
LOOP300:
IF LE N4 0
MESS "*** Empty operand out ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; ***** Write the remap to disk
;
N98 = N98+N3+1+N4 ; Track output file size
IF LE N98 768 ; Do not write too much
IF NOT FLAG(8) ; IF table size OK, and not syntax
ITOC N4 S5 ; Move len to a char string
WRITE S3 N3 ; Write keycode
WRITE S5 1 ; Write 1 byte length
WRITE S4 N4 ; And write the operand
ENDIF
ELSE
MESS "*** Output max size exceeded ***"
INC N99 ; Count the error
ENDIF
GOTO Loop
;
; End of compilation - clear the window limits and close output
;
End_Compile:
DWINDOW CLEAR ; CLEAR THE display window
FCLOSEO ; CLose the output (OK if not open)
FCLOSEI ; CLose the input
;
; Open a descriptive window
;
WOPEN 10,1, 14,77 (contrast) ErrEsc
ATSAY 11, 3 (contrast) "The output file is "*N98*" bytes"
ATSAY 12, 3 (contrast) "There were "*N99*" errors"
IF GT N98 768
ATSAY 13,3 (contrast) "Warning: ^GThe output file was truncated to the maximum allowed"
ENDIF
ATSAY 14,26 (contrast) " Press any key to continue "
KEYGET S0 ; Wait for any key
WCLOSE ; Restore screen under
;
; Drop the Final window and we're done
;
WCLOSE
RETURN
;
; ----- Open a window and display a menu
;
Window:
WOPEN 0 ,10 19,70 (default)
ATSAY 0 ,12 (default) " COM-AND Remapping "
ATSAY 1 ,11 (default) " COM-AND version 2.4 allows the keyboard to be remapped. "
ATSAY 2 ,11 (default) " Any keystroke COM-AND can detect (it cannot detect all) "
ATSAY 3 ,11 (default) " may be assigned to another key or keys. Macros may be "
ATSAY 4 ,11 (default) " created using this facility, as well as simple remaps. "
ATSAY 6 ,11 (default) " Source text files are created indpendantly and compiled "
ATSAY 7 ,11 (default) " with this script into the COM-AND.RMP file for use. "
ATSAY 8 ,10 (default) "├───────────────────────────────────────────────────────────┤"
ATSAY 9 12 (default) "1) Compile source into a new remap"
ATSAY 10 12 (default) "2) Syntax check a source file"
ATSAY 11 12 (default) "3) Search for files (Alt-F)"
ATSAY 12 12 (default) "4) Edit a file (you supply the editor)"
ATSAY 13 12 (default) "5) Turn remap on (using current map)"
ATSAY 14 12 (default) "6) Turn remap off"
ATSAY 15,10 (default) "├───────────────────────────────────────────────────────────┤"
ATSAY 16,12 (default) "Output: "*S19(0:48)
ATSAY 17,10 (default) "├───────────────────────────────────────────────────────────┤"
ATSAY 18,12 (default) "Select:"
ATSAY 19 32 (default) " Press ESC to exit "
RETURN